perm filename BEAM1[1,LCS] blob sn#816382 filedate 1986-05-01 generic text, type T, neo UTF8
C**** BEAMS.F4 ****
COPYRIGHT 1986 BY LELAND SMITH
C*** BEAMS, BMREAD, NREST, NOTAIL, FUZZ ************
        SUBROUTINE BEAMS
        INTEGER UPDN
        COMMON /STF/RSTFAC(8),RSTJ2
     1 /XRN/RN(1) /RNW/RNW /A2Z/LAA,LBB
     1 /dpymem/R(15,150),rpos(2,100),POSNT(150),RHY(100),jstdir(150)
     1 ,ntptr(150)
     1 /RMOD/staff,SET4,IBEAM,NOSET,STEM,JSTUP,NTC,PS2,IZ,JSTEM,
     1 IRHY,POSB /ALF/INP(100) /LIMIT/LIMIT,ITEM,LL,IRN,IX
     1 /mode/mode,jm,ioct,mm,nn,motend,ichd /v/kv,v(150)
        DATA TILT/2.0/
 
        write(*,*)kv,(v(j),j=1,kv)

        INVT=-1
        LS=IRN
C SAVE PTR TO RN ARRAY FOR SLUR FEATURE AT 614 (AND TREM. FEATURE)
        JNTC=NTC
c NTC is note count??
        J=0
        A=-1.
        DO 1125 K=1,IZ
        RHY(K)=0.
C MUST BE ZEROED TO AVOID CONFUSION AT C.2212
        IF(R(1,K).GT.2.)GO TO 1125
C GET BACK RHYTH. INFO IN P7 OF NOTES  (FOR JDIF, COMPOSITE BEAMS)
        B=R(3,K)
        IF(A.EQ.B)GO TO 1125
C SKIP CHORD NOTES.
        A=B
        J=J+1
        rhy(k)=r(7,j)
c why not do this in RHYTHM???????
c RHY holds complete list of note rhythms (make rests neg??)
1125    CONTINUE
 
        if(v(1).ne.9999.)GO TO 500
c 'B' puts 9999 in first slot
C  TYPE 'nB' OR 'nBj' ETC. FOR AUTOMATIC BEAMS. (2=DUPLE  3=TRIPLE)
         A=V(2)/2.
         JB=V(3)
C  '2'=1  '3'=1.5   '2B3;'  MEANS THERE'S A 3 NOTE PICK-UP.
C STEM=10 OR 20 IF ALREADY SETUP IN NOTES
        N=0
        J=0
        NN=0
        NX=0
C NX IS REST COUNTER
        NZ=0
        NL=1
        NJ=0
        NR=1
        JV=0
C  JV IS VX COUNTER
        C=0.
        B=A-.001
        IF(JB.EQ.0)GO TO 122
C JB=NUM OF PICKUP ITEMS.***(NTS AND RSTS - BUT NOT GRACE NTS.)****
        B=-.001
        DO 222 K=1,JB
c222     IF(V(K).LT.64.)B=B+ABS(V(K))
222     if(rhy(k).lt.64.)b=b+abs(rhy(k))                                C  ABOVE FOUND VALUE OF PICKUPS
122     X=ABS(rhy(NR))
c NR is rhythm counter
        IF(X.LT.64.)GO TO 2122
        NN=NN+1
        GO TO 2022
2122    C=C+X
C  ADD ON RHYTH VALUE -- IF NOT GRACE NOTES
        IF(rhy(NR).LT.0.)N=N+1
C  FINDS RESTS AND GRACE NOTES (WE SKIP THEM)
        IF(C.GT.B)GO TO 822
2022    IF(NR.EQ.IRHY)GO TO 422
922     NR=NR+1
C  NR=RIGHT SIDE OF BEAM, NL=LEFT
        GO TO 122
822     IF(NR-NL-NN-N.GT.0)GO TO 322
C  IGNORE IF ONLY ONE NOTE FILLS UNIT
722     IF(NR.EQ.IRHY)GO TO 422
        NN=0
        NJ=NJ+N
        NZ=NJ
        N=0
        NL=NR+1
C PUSH AHEAD FOR NEXT BEAM
622     B=B+A
C UPDATE SPACE POINTER
        IF(C.GT.B)GO TO 622
        GO TO 922
 
C  MAIN AUTO BEAM SECTION. 
322     DO 21 K=NL,NR-1
C THIS LOOP FINDS FIRST NOTE OF BEAM.
        X=rhy(K)
        IF(X.LT.0.)GO TO 21
        IF(X.GE.64.)GO TO 21
        IF(NOTAIL(X).LT.0)GO TO 21
C SKIP IF NOTE VAL. DOESN'T REQUIRE A TAIL 
COUNTER FOR VX ARRAY (WHERE WE PUT BEAM'S NOTE NUMS.)
        V(JV+1)=K-NREST(K)
C FUNCT. NREST TELLS HOW MANY RESTS TO SUBTRACT
        GO TO 221
21      CONTINUE
C IF WE GET HERE, NO BEAM NOTES FOUND.
        GO TO 722
221     DO 321 JB=K,NR
C THIS LOOP FINDS LAST NOTE OF BEAM.
        X=rhy(JB)
        IF(NOTAIL(X).LT.0)GO TO 522
C JUMP OUT WHEN NON-BEAM DURATION IS FOUND
        IF(X.LT.0.)GO TO 321
        IF(X.GE.64.)GO TO 321
        JA=JB
321     CONTINUE
522     IF(JA.EQ.K)GO TO 523
        JV=JV+2
        V(JV)=JA-NREST(JA)
C NREST SUBTRACTS ALL INTERVENING RESTS
523     IF(JA.GE.NR-1)GO TO 722
C NO ROOM FOR MORE BEAMS
        NL=JB
C START FROM WHERE WE LEFT OFF
        GO TO 322
 
C  NEXT FOR BEAMED GRACE NOTES
422     N=0
        J=1
1122    X=rhy(J)
        IF(X.LT.0.)N=N+1
        NR=0
        IF(X.LT.64.)GO TO 1022
        NL=J
        DO 1222 K=J,IRHY
        X=rhy(K)
        IF(X.LT.0..OR.X.LT.64.)GO TO 1322
C  STOPS GRACE NOTE BEAM AT REST OR NON-GRACE
1222    NR=K
1322    IF(NR-NL.LE.0)GO TO 1022
        CALL BAUTO(JV,NL,NR,N)
C UPDATE V COUNTER
        NL=NL+1
        J=NR
1022    J=J+1
        IF(J.LE.IRHY)GO TO 1122
 
1422    IF(JV.EQ.0)RETURN
C  NO BEAMS - SO GO BACK.
        DO 2822 K=JV+1,50
C  ?? USES ONLY 68 SLOTS IN 'V'
2822    V(K)=0.
 
        J=0
        GO TO 511

C  *******  1ST MAIN LOOP *********
500     J=0
511     J=J+1